home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / H-K / Hello Tabby Folder / HelloTabby.p < prev    next >
Encoding:
Text File  |  1989-07-22  |  9.1 KB  |  283 lines  |  [TEXT/PJMM]
  1. unit HelloTabby;
  2.  
  3. { Written by Pete Johnson, Glassell Park BBS, 213-258-7649                    }
  4.  
  5. { Source for a LightSpeed Pascal unit which handles the Tabby launch.next        }
  6. { file and returns the name of the next application to launch in a variable    }
  7. { called NextLaunch.                                                }
  8.  
  9. { This source code is being made public in the hopes that it will lead to more    }
  10. { and better Tabby applications. I ask only that you credit me with a thanks    }
  11. { if you incorporate any or all of this code in an application.                }
  12.  
  13. { I have no doubt that this code could be made better. If you improve on it,    }
  14. { please share your ideas.                                            }
  15.  
  16. { If you're not using LightSpeed Pascal, you're on your own. I don't know        }
  17. { any other Pascal compilers. I'm sure someone other than me can help you        }
  18. { if you need to convert this code for Turbo, TML or Apple's MPW Pascal.        }
  19.  
  20. { Thanks to Erik Selberg, who has been a real help.                        }
  21.  
  22. { How to use this code:                                                }
  23.  
  24. {  <1> Create a LightSpeed Pascal Project                                }
  25. {  <2> Add the Globals.p file first, then add the HelloTabby.p file            }
  26. {  <3> Create your own additional files                                    }
  27.  
  28. { You should include an STR  resource 500 in the Project: this holds the name    }
  29. { of the default launch.next application (usually 'Red Ryder Host').            }
  30.  
  31. {   Your main program Unit should include the following lines at its start:    }
  32.  
  33. {     uses                                                        }
  34. {       Globals, HelloTabby;                                            }
  35.  
  36. {   End the main procedure of your program as follows:                        }
  37.  
  38. {    HelloTabby;                                                    }
  39. {    if NextLaunch <> '' then                                            }
  40. {       LaunchNextAppl                                                }
  41. {    end.                                                            }
  42.  
  43.  
  44. {            ********** History **********                                }
  45.  
  46. { Modified March 11, 1989, to handle up to 100 events of < 32 chars apiece.    }
  47. { Modified April 17 and May 6, 1989, to handle MultiFinder.                    }
  48. { Modified June 11, 1989, to use Toolbox file calls.                        }
  49. { Modified June 15, 1989, to use Tabby Setup name for 'BBS' string.            }
  50. { Modified July 22, 1989, for additional error checking.                    }
  51.  
  52. {    Next four lines handle Debug, Names, Overflow and Range                }
  53. {    checking options in compiler.                                        }
  54.  
  55. {$D+}
  56. {$N+}
  57. {$V+}
  58. {$R+}
  59.  
  60. interface
  61.  
  62. uses
  63.     Globals;
  64.  
  65. type
  66.     pLaunchStruct = ^LaunchStruct;
  67.     LaunchStruct = record
  68.             pfName: StringPtr;
  69.             param: INTEGER;
  70.             LC: packed array[0..1] of CHAR;    {    extended parameters:                                }
  71.             extBlockLen: LONGINT;                     {    number of bytes in extension = 6                    }
  72.             fFlags: INTEGER;                            {    Finder file info flags                                }
  73.             launchFlags: LONGINT;                     {    bit 31,30=1 for sublaunch, others reserved    }
  74.         end;                                             {    LaunchStruct                                            }
  75.  
  76. var
  77.     NextLaunch: STR255;
  78.     MultiFinder: boolean;
  79.  
  80. procedure LaunchNextAppl;
  81.  
  82. procedure HelloTabby;
  83.  
  84.  
  85. implementation
  86.  
  87. { ------------------------------------------------------ }
  88. procedure ReadConfig;
  89.  
  90.     var
  91.         ConfigRefNum: integer;
  92.         logicalEOF, CharsToSend: longint;
  93.         MFByte: SignedByte;
  94.  
  95.     begin
  96.         MultiFinder := false;
  97.         CharsToSend := 1;
  98.         FileError := FSOpen('Config', vRefNum, ConfigRefNum);
  99.         if FileError = noErr then
  100.             begin
  101.                 FileError := GetEOF(ConfigRefNum, logicalEOF);
  102.                 if (FileError = noErr) & (logicalEOF = 349) then
  103.                     begin
  104.                         FileError := SetFPos(ConfigRefNum, fsFromStart, 316);
  105.                         FileError := FSRead(ConfigRefNum, CharsToSend, @MFByte);
  106.                         if MFByte <> 0 then
  107.                             MultiFinder := true;
  108.                     end        {    if (FileError = noErr) & (logicalEOF = 349)    }
  109.             end;        {    if FileError = noErr    }
  110.         FileError := FSClose(ConfigRefNum);
  111.     end;
  112.  
  113. { ------------------------------------------------------ }
  114.  
  115. function Launchit (pLnch: pLaunchStruct): OSErr;
  116.  
  117. inline
  118.     $205F, $A9F2, $3E80;
  119.  
  120. { ------------------------------------------------------ }
  121.  
  122. procedure LaunchNextAppl;
  123.  
  124.     var
  125.         pMyLaunch: pLaunchStruct;
  126.         myLaunch: LaunchStruct;
  127.         MyPB: CInfoPBRec;
  128.  
  129.     begin
  130.  
  131.         with MyPB do
  132.             begin
  133.                 ioNamePtr := @NextLaunch;
  134.                 ioVRefNum := vRefNum;
  135.                 ioFDirIndex := 0;
  136.                 ioDirID := 0;
  137.             end;    {    with    }
  138.         FileError := PBGetCatInfo(@MyPB, false);
  139.  
  140.         pMyLaunch := @myLaunch;
  141.         with pMyLaunch^ do
  142.             begin
  143.                 pfName := @NextLaunch;
  144.                 param := 0;
  145.                 LC[0] := 'L';
  146.                 LC[1] := 'C';
  147.                 extBlockLen := 6;
  148.                 fFlags := myPB.ioFlFndrInfo.fdFlags;
  149.                 if MultiFinder then
  150.                     LaunchFlags := $C0000000        {    set BOTH high bits for a sublaunch    }
  151.                 else
  152.                     LaunchFlags := $00000000;        {    just launch, then quit    }
  153.             end;        {    with pMyLaunch^    }
  154.         FileError := Launchit(pMyLaunch);
  155.     end;
  156.  
  157. { ------------------------------------------------------ }
  158.  
  159. procedure HelloTabby;
  160.  
  161. { This procedure looks for a Tabby launch.next file. If it's found, it         }
  162. { extracts the events, which are comma delimited, saves the first one            }
  163. { for the next launch and rewrites the file from event #2 to the last            }
  164. { event.                                                            }
  165.  
  166. { If it finds only one event, it kills the launch.next file.                   }
  167.  
  168. { If there are no events, it returns the application name contained in        }
  169. { STR  500 as STR255 NextLaunch, otherwise it uses NextLaunch to hold          }
  170. { the first entry in the launch.next script.                                 }
  171.  
  172. { Before returning, it also checks that the NextLaunch application exists        }
  173. { by trying to    open it. If the open attempt fails, it returns NextLaunch        }
  174. { as an empty string.                                                }
  175.  
  176.     type
  177.         HundredEvents = array[1..100] of string[32];
  178.         ManyChars = packed array[1..3300] of char;    {    Can hold 100 32-length events, commas and one <CR>    }
  179.  
  180.     var
  181.         EventCounter, EventLimit, LNRefNum, LaunchCount: integer;
  182.         LNChar: char;
  183.         BBSByte: SignedByte;
  184.         TheChars: ManyChars;
  185.         Event: HundredEvents;
  186.         Events, ThisEvent, VolName, TempString, BBSName: STR255;
  187.         logicalEOF, Quantity, CharIndex: longint;
  188.         CharCount, SetUpRef, SetUpCount: integer;
  189.         fndrInfo: FInfo;
  190.  
  191.     begin
  192.         FileError := GetVol(@VolName, vRefNum);        { Get volume ref # for default volume }
  193.         Events := '';
  194.         for EventCounter := 1 to 100 do
  195.             Event[EventCounter] := '';
  196.         ThisEvent := '';
  197.         LNChar := chr(255);                    {    Dummy value so we can spot this first time through    }
  198.         NextLaunch := GetString(500)^^;        {    Get next launch string from resource    }
  199.         ReadConfig;                        {    See if we're running MultiFinder    }
  200.         EventCounter := 1;
  201.         FileError := FSOpen('launch.next', vRefNum, LNRefNum);
  202.         FileError := GetEOF(LNRefNum, logicalEOF);
  203.         if (logicalEOF > 0) and (FileError = NoErr) then
  204.             begin
  205.                 FileError := SetFPos(LNRefNum, fsFromStart, 0);
  206.                 LaunchCount := 0;
  207.                 while (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
  208.                     begin
  209.                         while (LNChar <> ',') & (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) do
  210.                             begin
  211.                                 if (LNChar <> chr(255)) then
  212.                                     ThisEvent := concat(ThisEvent, LNChar);
  213.                                 LaunchCount := LaunchCount + 1;
  214.                                 Quantity := 1;
  215.                                 FileError := FSRead(LNRefNum, Quantity, @LNChar);
  216.                                 LNChar := chr(ord(LNChar) div 256);
  217.                             end;            { (LNChar <> ',') & (LNChar <> chr(15)) & (LaunchCount <= logicalEOF) }
  218.                         Event[EventCounter] := ThisEvent;
  219.                         EventCounter := EventCounter + 1;
  220.                         ThisEvent := '';
  221.                         LNChar := chr(255)
  222.                     end;            { (LNChar <> chr(13)) & (LaunchCount <= logicalEOF) }
  223.                 FileError := FSClose(LNRefNum);
  224.                 FileError := FSDelete('launch.next', vRefNum);
  225.                 EventLimit := (EventCounter - 2);
  226.                 if EventLimit > 1 then
  227.                     begin
  228.                         FileError := Create('launch.next', vRefNum, 'QUED', 'TEXT');
  229.                         FileError := FSOpen('launch.next', vRefNum, LNRefNum);
  230.                         FileError := SetFPos(LNRefNum, fsFromStart, 0);
  231.                         CharIndex := 0;
  232.                         for EventCounter := 2 to EventLimit do
  233.                             begin
  234.                                 TempString := Event[EventCounter];
  235.                                 for CharCount := 1 to length(TempString) do
  236.                                     TheChars[CharIndex + CharCount] := TempString[CharCount];
  237.                                 CharIndex := CharIndex + length(TempString) + 1;
  238.                                 if EventCounter <> EventLimit then
  239.                                     TheChars[CharIndex] := ','
  240.                                 else
  241.                                     TheChars[CharIndex] := ENDLINE;
  242.                             end; {Counter loop}
  243.                         FileError := FSWrite(LNRefNum, CharIndex, @TheChars);
  244.                         FileError := FSClose(LNRefNum);
  245.                         FileError := FlushVol(@volName, vRefNum);
  246.                     end; {EventLimit > 1}
  247.                 if EventLimit > 0 then
  248.                     NextLaunch := Event[1];
  249.                 TempString := NextLaunch;
  250.                 UprString(TempString, false);
  251.                 if TempString = 'BBS' then
  252.                     begin
  253.                         FileError := FSOpen('Tabby:Tabby Setup', vRefNum, SetupRef);
  254.                         if FileError = NoErr then
  255.                             FileError := GetEOF(SetupRef, logicalEOF);
  256.                         if (logicalEOF > 0) & (FileError = NoErr) then
  257.                             begin
  258.                                 FileError := SetFPos(SetupRef, fsFromStart, 0);
  259.                                 BBSName := '';
  260.                                 Quantity := 1;
  261.                                 BBSByte := 0;
  262.                                 SetupCount := 0;
  263.                                 while (BBSByte <> 13) & (SetupCount <= logicalEOF) do
  264.                                     begin
  265.                                         FileError := FSRead(LNRefNum, Quantity, @BBSByte);
  266.                                         if BBSByte <> 13 then
  267.                                             BBSName := concat(BBSName, chr(BBSByte));
  268.                                     end;        {    while (BBSByte <> 13) & (SetupCount <= logicalEOF)    }
  269.                                 FileError := FSClose(SetupRef);
  270.                                 NextLaunch := BBSName;
  271.                             end        {    if logicalEOF > 0 for 'Tabby:Tabby Setup'    }
  272.                     end;        {    if TempString = 'BBS'     }
  273.             end        {    if logicalEOF > 0 for 'launch.next'    }
  274.         else
  275.             begin
  276.                 FileError := FSClose(LNRefNum);
  277.                 FileError := FSDelete('launch.next', vRefNum)
  278.             end;
  279.         FileError := GetFInfo(NextLaunch, vRefNum, fndrInfo);    {    Is it an application?    }
  280.         if (FileError <> noErr) | (fndrInfo.fdType <> 'APPL') then
  281.             NextLaunch := ''
  282.     end;            { HelloTabby procedure }
  283. end.                { Unit }